home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr51 / lib201.zip / NAVIGATE.PRG < prev    next >
Encoding:
Text File  |  1993-02-23  |  28.8 KB  |  754 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program...: NAVIGATE.PRG
  3. *-- Programmer: Ken Mayer (CIS: 71333,1030)
  4. *-- Date......: 02/23/1993
  5. *-- Notes.....: These are interesting functions designed to help out in 
  6. *--             navigation ... see the file: README.TXT for details on the
  7. *--             use of this library file. 
  8. *--             NOTE -- a few functions have been added into this library
  9. *--             that are duplicated elsewhere (other library files). This is
  10. *--             due to a limitation with dBASE IV, 1.5's handling of libraries.
  11. *--             These functions are (and are from):
  12. *--             STRIP2VAL()   from STRINGS.PRG
  13. *--             STRIPVAL()
  14. *--             STRPBRK()
  15. *--             HAV()         from TRIG.PRG
  16. *--             AHAV()
  17. *--             CSCH()
  18. *--             SINH()
  19. *-------------------------------------------------------------------------------
  20.  
  21. FUNCTION Correct
  22. *-------------------------------------------------------------------------------
  23. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  24. *-- Date........: 03/01/1992
  25. *-- Notes.......: Correction of direction - adjusts direction given, in degrees,
  26. *--               by second number of degrees.  Use to convert a compass
  27. *--               direction to magnetic using deviation as the second argument,
  28. *--               or magnetic to true using variation as the second argument.
  29. *--               Returns a direction in degrees.
  30. *--
  31. *--               A westerly second argument may be given either as a negative
  32. *--               number or as a character value containing "W".  If second
  33. *--               argument is character-type but contains a negative value,
  34. *--               effect of presence or absence of "W" is reversed.  That is,
  35. *--               "-20 W" is treated like "20 E" or the number 20.
  36. *-- Written for.: dBASE IV, 1.1
  37. *-- Rev. History: 03/01/1992 -- Original Release
  38. *-- Calls.......: None
  39. *-- Called by...: Any
  40. *-- Usage.......: Correct(<nDirection>,<xCorrection>)
  41. *-- Example.....: ?Correct(50,"-10 E")
  42. *-- Returns.....: Numeric (direction in degrees)
  43. *-- Parameters..: nDirection  = Heading
  44. *--               xCorrection = amount to 'correct' by, may be numeric or
  45. *--                             character, see above under 'Notes'.
  46. *-------------------------------------------------------------------------------
  47.  
  48.     parameters nDirection, xCorrection
  49.     private nCval
  50.     if type( "xCorrection" ) = "C"
  51.       nCval = val( xCorrection )
  52.       if "W" $ upper( xCorrection )
  53.         nCval = - nCval
  54.       endif
  55.     else
  56.       nCval = xCorrection
  57.     endif
  58.     
  59. RETURN mod( 360 + nDirection + nCval, 360 )
  60. *-- EoF: Correct()
  61.  
  62. FUNCTION UnCorrect
  63. *-------------------------------------------------------------------------------
  64. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  65. *-- Date........: 03/01/1992
  66. *-- Notes.......: Uncorrection of direction - adjusts direction given, in 
  67. *--               degrees, by second number of degrees.  The inverse of 
  68. *--               correct(), see above. Use to convert a true direction to 
  69. *--               magnetic using variation as the second argument, or magnetic
  70. *--               to compass using deviation as the second argument.
  71. *-- Written for.: dBASE IV, 1.1
  72. *-- Rev. History: 03/01/1992 -- Original Release
  73. *-- Calls.......: None
  74. *-- Called by...: Any
  75. *-- Usage.......: UnCorrect(<nDirection>,<xUnCorr>)
  76. *-- Example.....: ?UnCorrect(50,"-10 E")
  77. *-- Returns.....: Numeric (direction in degrees)
  78. *-- Parameters..: nDirection = Heading
  79. *--               xUnCorr    = amount to 'uncorrect' by, may be numeric or
  80. *--                             character, see above under 'Notes'.
  81. *-------------------------------------------------------------------------------
  82.  
  83.     parameters nDirection, xUncorr
  84.     private nCval
  85.     if type( "xUncorr" ) = "C"
  86.       nCval = val( xUncorr )
  87.       if "W" $ upper( xUncorr )
  88.         nCval = - nCval
  89.       endif
  90.     else
  91.       nCval = xUncorr
  92.     endif
  93.     
  94. RETURN mod( 360 + nDirection - nCval, 360 )
  95. *-- EoF: UnCorrect()
  96.  
  97. FUNCTION XAngle
  98. *-------------------------------------------------------------------------------
  99. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  100. *-- Date........: 03/01/1992
  101. *-- Notes.......: Angle in degrees ( <= 90 ) at which two vectors in
  102. *--               degrees intersect.
  103. *-- Written for.: dBASE IV, 1.1
  104. *-- Rev. History: 03/01/1992 -- Original Release
  105. *-- Calls.......: None
  106. *-- Called by...: Any
  107. *-- Usage.......: XAngle(<nVector1>,<nVector2>)
  108. *-- Example.....: ?UnCorrect(20,240)
  109. *-- Returns.....: Numeric (direction in degrees)
  110. *-- Parameters..: nVector1 = First angle
  111. *--               nVector2 = Second angle
  112. *-------------------------------------------------------------------------------
  113.  
  114.     parameters nVector1, nVector2
  115.     private nResult
  116.     nResult = abs( nVector1 - nVector2)
  117.     do case
  118.       case nResult > 270
  119.             nResult = 360 - Result
  120.       case nResult > 180
  121.         nResult = nResult - 180
  122.       case nResult > 90
  123.         nResult = 180 - nResult
  124.     endcase
  125.     
  126. RETURN nResult
  127. *-- EoF: XAngle()
  128.  
  129. FUNCTION LeftWind
  130. *-------------------------------------------------------------------------------
  131. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  132. *-- Date........: 03/01/1992
  133. *-- Notes.......: Whether effect of second vector on first is from the
  134. *--               left or the right.  Returns .T. if from the left, else .F.
  135. *--               Expects vectors in degrees.
  136. *--
  137. *--               For convenience in aviation calculations, the second
  138. *--               argument is expected as the direction FROM which
  139. *--               the wind or current is coming, not the direction TO
  140. *--               which it is going.  If the contrary sense
  141. *--               is more convenient, change the "=" sign in the
  142. *--               function to "#".
  143. *-- Written for.: dBASE IV, 1.1
  144. *-- Rev. History: 03/01/1992 -- Original Release
  145. *-- Calls.......: None
  146. *-- Called by...: Any
  147. *-- Usage.......: LeftWind(<nCourse>,<nWindFrom>)
  148. *-- Example.....: ?LeftWind(20,240)
  149. *-- Returns.....: Numeric (direction in degrees)
  150. *-- Parameters..: nCourse   = Direction of heading ...
  151. *--               nWindFrom = Direction wind or current is coming from
  152. *-------------------------------------------------------------------------------
  153.  
  154.     parameters nCourse, nWindfrom
  155.     
  156. RETURN ( nCourse > nWindfrom ) = ( abs( nCourse - nWindfrom ) < 180 )
  157. *-- EoF: LeftWind()
  158.  
  159. FUNCTION TailWind
  160. *-------------------------------------------------------------------------------
  161. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  162. *-- Date........: 03/01/1992
  163. *-- Notes.......: Whether effect of second vector on first is additive
  164. *--               or subtractive ( from behind or from ahead ).
  165. *-- 
  166. *--               For convenience in aviation calculations, the second
  167. *--               argument is expected as the direction FROM which
  168. *--               the wind or current is coming, not the direction TO
  169. *--               which is going.  If the contrary sense
  170. *--               is more convenient, change the "<" sign in the
  171. *--               function to ">".
  172. *-- Written for.: dBASE IV, 1.1
  173. *-- Rev. History: 03/01/1992 -- Original Release
  174. *-- Calls.......: None
  175. *-- Called by...: Any
  176. *-- Usage.......: TailWind(<nCourse>,<nWindFrom>)
  177. *-- Example.....: ?TailWind(20,240)
  178. *-- Returns.....: Numeric (direction in degrees)
  179. *-- Parameters..: nCourse   = Direction of heading ...
  180. *--               nWindFrom = Direction wind or current is coming from
  181. *-------------------------------------------------------------------------------
  182.  
  183.     parameters nCourse, nWindfrom
  184.     
  185. RETURN ( abs( abs( nCourse - nWindfrom ) - 180 ) < 90 )
  186. *-- EoF: TailWind()
  187.  
  188. FUNCTION Heading
  189. *-------------------------------------------------------------------------------
  190. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  191. *-- Date........: 03/01/1992
  192. *-- Notes.......: Heading required to make good a course.
  193. *--               If using this for boating and the direction of set is
  194. *--               more convenient than the direction from which
  195. *--               it is coming, apply mod( 180 + direction, 360 )
  196. *--               to the fourth argument before calling.
  197. *-- Written for.: dBASE IV, 1.1
  198. *-- Rev. History: 03/01/1992 -- Original Release
  199. *-- Calls.......: XANGLE()             Function in NAVIGATE.PRG
  200. *--               LEFTWIND()           Function in NAVIGATE.PRG
  201. *-- Called by...: Any
  202. *-- Usage.......: Heading(<nCourse>,<nAirSpeed>,<nWindFrom>,<nForce>)
  203. *-- Example.....: ?Heading(20,5,240,2)
  204. *-- Returns.....: Numeric (direction in degrees)
  205. *-- Parameters..: nCourse   = Direction of heading ...
  206. *--               nAirSpeed = What it says
  207. *--               nWindFrom = Direction wind or current is coming from
  208. *--               nForce    = Windforce
  209. *-------------------------------------------------------------------------------
  210.  
  211.     parameters nCourse, nAirspeed, nWindfrom, nForce
  212.     private nCrabAngle
  213.     nCrabAngle = rtod( asin( nForce * sin( dtor( xangle( nCourse, nWindfrom))) ;
  214.           / nAirspeed ) )
  215.     nCrabAngle = iif( leftwind( nCourse, nWindfrom ), -nCrabAngle, nCrabAngle )
  216.     nCrabAngle = mod( 360 + nCourse + nCrabAngle, 360 )
  217.     
  218. RETURN iif( abs( nCrabAngle ) < 360, nCrabAngle, -1 )
  219. *-- EoF: Heading()
  220.  
  221. FUNCTION Course
  222. *-------------------------------------------------------------------------------
  223. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  224. *-- Date........: 03/01/1992
  225. *-- Notes.......: Course made good given heading, speed and wind direction 
  226. *--               and force.
  227. *-- Written for.: dBASE IV, 1.1
  228. *-- Rev. History: 03/01/1992 -- Original Release
  229. *-- Calls.......: XANGLE()             Function in NAVIGATE.PRG
  230. *--               LEFTWIND()           Function in NAVIGATE.PRG
  231. *--               TAILWIND()           Function in NAVIGATE.PRG
  232. *-- Called by...: Any
  233. *-- Usage.......: Course(<nHeading>,<nAirSpeed>,<nWindFrom>,<nForce>)
  234. *-- Example.....: ?Course(20,5,240,2)
  235. *-- Returns.....: Numeric (direction in degrees)
  236. *-- Parameters..: nHeading  = Direction of heading ...
  237. *--               nAirSpeed = What it says
  238. *--               nWindFrom = Direction wind or current is coming from
  239. *--               nForce    = Windforce
  240. *-------------------------------------------------------------------------------
  241.  
  242.     parameters nHeading, nAirspeed, nWindfrom, nForce
  243.     private nTemp, nCrabAngle
  244.     nTemp = dtor( xangle( nHeading, nWindfrom ) )
  245.     nCrabAngle = nAirspeed - nForce * cos( nTemp ) ;
  246.        * iif( tailwind( nHeading, nWindfrom ), -1, 1 )
  247.     if nCrabAngle < 0
  248.       nCrabAngle = 0
  249.     else
  250.       nCrabAngle = abs( rtod( atan( nForce * sin( nTemp ) / nCrabAngle ) ) )
  251.       nCrabAngle = iif( leftwind( nHeading,nWindfrom ), nCrabAngle, -nCrabAngle)
  252.     endif
  253.     
  254. RETURN mod( 360 + nHeading + nCrabAngle, 360 )
  255. *-- EoF: Course()
  256.  
  257. FUNCTION GndSpeed
  258. *-------------------------------------------------------------------------------
  259. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  260. *-- Date........: 03/01/1992
  261. *-- Notes.......: Speed over the ground given heading, speed
  262. *--               and wind direction and force.
  263. *-- Written for.: dBASE IV, 1.1
  264. *-- Rev. History: 03/01/1992 -- Original Release
  265. *-- Calls.......: XANGLE()             Function in NAVIGATE.PRG
  266. *--               TAILWIND()           Function in NAVIGATE.PRG
  267. *-- Called by...: Any
  268. *-- Usage.......: GndSpeed(<nHeading>,<nAirSpeed>,<nWindFrom>,<nForce>)
  269. *-- Example.....: ?GndSpeed(20,5,240,2)
  270. *-- Returns.....: Numeric (direction in degrees)
  271. *-- Parameters..: nHeading  = Direction of heading ...
  272. *--               nAirSpeed = What it says
  273. *--               nWindFrom = Direction wind or current is coming from
  274. *--               nForce    = Windforce
  275. *-------------------------------------------------------------------------------
  276.  
  277.     parameters nHeading, nAirspeed, nWindfrom, nForce
  278.     private nTemp
  279.     nTemp  = cos( dtor( xangle( nHeading, nWindfrom ) ) ) ;
  280.        * iif( tailwind( nHeading, nWindfrom ), -1, 1 )
  281.     nTemp = nAirspeed * nAirspeed + nForce * nForce ;
  282.        - 2 * nAirspeed * nForce * nTemp
  283.  
  284. RETURN iif(nTemp<=0,nAirspeed+nForce*iif(tailwind(nHeading,nWindfrom ),1,-1),;
  285.                 sqrt(nTemp))
  286. *-- EoF: GndSpeed()
  287.  
  288. FUNCTION Deg2Num
  289. *-------------------------------------------------------------------------------
  290. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  291. *-- Date........: 03/01/1992
  292. *-- Notes.......: Degrees to number: String in the form " 40d50'30.2 N" is 
  293. *--               converted to a number of degrees.  If followed by E or S, 
  294. *-                sign will be reversed.
  295. *--
  296. *--               It doesn't matter what characters are used to separate the
  297. *--               degrees, minutes and seconds, but any of the characters N, E,
  298. *--               W and S or their lowercase equivalents following the last 
  299. *--               digit will be understood as specifying a compass direction.
  300. *-- 
  301. *--               If the degrees or minutes are 0, they must nevertheless be
  302. *--               included in the argument.  Seconds may be omitted if 0, as
  303. *--               may the minutes if 0 and seconds are omitted.
  304. *-- Written for.: dBASE IV, 1.1
  305. *-- Rev. History: 03/01/1993 -- Original Release
  306. *-- Calls.......: STRIP2VAL()          Function in STRINGS.PRG
  307. *--               STRIPVAL()           Function in STRINGS.PRG
  308. *--               STRPBRK()            Function in STRINGS.PRG
  309. *-- Called by...: Any
  310. *-- Usage.......: Deg2Num(<cDms>)
  311. *-- Example.....: ?Deg2Num("40d50'30.2 N")
  312. *-- Returns.....: Numeric (degrees)
  313. *-- Parameters..: cDms = Degrees Minutes Seconds
  314. *-------------------------------------------------------------------------------
  315.  
  316.     parameters cDms
  317.     private nResult, cStrleft
  318.     if type( "cDms" ) $ "NF"
  319.       RETURN CDms
  320.     endif
  321.     cStrleft = strip2val( cDms )
  322.     nResult = val( cStrleft )
  323.     if "" # strip2val( stripval( cStrleft ) )
  324.       cStrleft = strip2val( stripval( cStrleft ) )
  325.       nResult = nResult + val( cStrleft ) / 60
  326.       if "" # strip2val( stripval( cStrleft ) )
  327.         cStrleft = strip2val( stripval( cStrleft ) )
  328.         nResult = nResult + val( cStrleft ) / 3600
  329.       endif
  330.     endif
  331.     cStrleft = upper( ltrim( stripval( cStrleft ) ) )
  332.     if strpbrk( "NW", cStrleft ) > 0 .or. strpbrk( "ES",cStrleft ) = 0
  333.       RETURN nResult
  334.     else
  335.       RETURN -nResult
  336.     endif
  337.  
  338. *-- EoF: Deg2Num()
  339.  
  340. FUNCTION BearsDist
  341. *-------------------------------------------------------------------------------
  342. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  343. *-- Date........: 03/01/1992
  344. *-- Notes.......: Distance to an object at the time of the second
  345. *--               bearing, given two bearings and the distance run
  346. *--               between them.  Value returned will be in same
  347. *--               units as third argument; first two are in degrees.
  348. *--               Returns -1 if already past the object.
  349. *-- Written for.: dBASE IV, 1.1
  350. *-- Rev. History: 03/01/1992 -- Original Release
  351. *-- Calls.......: None
  352. *-- Called by...: Any
  353. *-- Usage.......: BearsDist(<nBear1>,<nBear2>,<nRun>)
  354. *-- Example.....: ?BearsDist(200,150,5)
  355. *-- Returns.....: Numeric (degrees)
  356. *-- Parameters..: nBear1 = Bearing of First object
  357. *--               nBear2 = Bearing of Second object
  358. *--               nRun   = Distance (or time) run between bearings
  359. *-------------------------------------------------------------------------------
  360.  
  361.     parameters nBear1, nBear2, nRun
  362.     if nBear2 > 180
  363.       if nBear1 < nBear2 .or. nBear2 < 270
  364.         RETURN -1
  365.       else
  366.         nBear1 = 360 - nBear1
  367.         nBear2 = 360 - nBear2
  368.       endif
  369.     else
  370.       if nBear2 < nBear1 .or. nBear2 > 90
  371.         RETURN -1
  372.       endif
  373.     endif
  374.  
  375. RETURN sin( dtor( nBear1 ) ) * nRun / sin( dtor( nBear2 - nBear1 ) )
  376. *-- EoF: BearsDist()
  377.  
  378. FUNCTION BearsPass
  379. *-------------------------------------------------------------------------------
  380. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  381. *-- Date........: 03/01/1992
  382. *-- Notes.......: Distance at which the object will be passed abeam:
  383. *--                                  * <-- Object
  384. *--                            .    /|
  385. *--                      .         / |
  386. *--                1-->-->-->--2  >  3  >
  387. *--               Where 1 = Position at time first bearing to object is
  388. *--                         taken,
  389. *--                     2 = position at second bearing,
  390. *--                     3 = position at which the object will be abeam.
  391. *-- Written for.: dBASE IV, 1.1
  392. *-- Rev. History: 03/01/1992 -- Original Release
  393. *-- Calls.......: None
  394. *-- Called by...: Any
  395. *-- Usage.......: BearsPass(<nBear1>,<nBear2>,<nRun>)
  396. *-- Example.....: ?BearsPass(200,150,5)
  397. *-- Returns.....: Numeric (degrees)
  398. *-- Parameters..: nBear1 = Bearing of First object
  399. *--               nBear2 = Bearing of Second object
  400. *--               nRun   = Distance (or time) run between bearings
  401. *-------------------------------------------------------------------------------
  402.  
  403.     parameters nBear1, nBear2, nRun
  404.     private nTemp
  405.     if nBear2 > 180
  406.       if nBear1 < nBear2 .or. nBear2 < 270
  407.         RETURN -1
  408.       else
  409.         nBear1 = 360 - nBear1
  410.         nBear2 = 360 - nBear2
  411.       endif
  412.     else
  413.       if nBear2 < nBear1 .or. nBear2 > 90
  414.         RETURN -1
  415.       endif
  416.     endif
  417.     nTemp = sin( dtor( nBear1 ) ) * nRun / sin( dtor( nBear2 - nBear1 ) )
  418.     
  419. RETURN nTemp * sin( dtor( nBear2 ) )
  420. *-- EoF: BearsPass()
  421.  
  422. FUNCTION BearsRun
  423. *-------------------------------------------------------------------------------
  424. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  425. *-- Date........: 03/01/1992
  426. *-- Notes.......: Distance to run until object will be abeam given two bearings.
  427. *--               Same rules and restrictions as bearsdist().
  428. *-- Written for.: dBASE IV, 1.1
  429. *-- Rev. History: 03/01/1992 -- Original Release
  430. *-- Calls.......: None
  431. *-- Called by...: Any
  432. *-- Usage.......: BearsRun(<nBear1>,<nBear2>,<nRun>)
  433. *-- Example.....: ?BearsRun(200,150,5)
  434. *-- Returns.....: Numeric (degrees)
  435. *-- Parameters..: nBear1 = Bearing of First object
  436. *--               nBear2 = Bearing of Second object
  437. *--               nRun   = Distance (or time) run between bearings
  438. *-------------------------------------------------------------------------------
  439.  
  440.     parameters nBear1, nBear2, nRun
  441.     private nTemp
  442.     if nBear2 > 180
  443.       if nBear1 < nBear2 .or. nBear2 < 270
  444.         RETURN -1
  445.       else
  446.         nBear1 = 360 - nBear1
  447.         nBear2 = 360 - nBear2
  448.       endif
  449.     else
  450.       if nBear2 < nBear1 .or. nBear2 > 90
  451.         RETURN -1
  452.       endif
  453.     endif
  454.     nTemp = sin( dtor( nBear1 ) ) * nRun / sin( dtor( nBear2 - nBear1 ) )
  455.  
  456. RETURN nTemp * cos( dtor( nBear2 ) )
  457. *-- EoF: BearsRun()
  458.  
  459. FUNCTION GcDist
  460. *-------------------------------------------------------------------------------
  461. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  462. *-- Date........: 03/01/1992
  463. *-- Notes.......: Great circle distance between two points given latitude
  464. *--               and longitude of each.  This function obtains the degrees of
  465. *--               arc along the great circle and simply multiplies by 60 to
  466. *--               convert the degrees to nautical miles.  As this ignores the
  467. *--               eccentricity of the earth, the answer may be in error by
  468. *--               approximately half of one percent.  In general, if the
  469. *--               route lies close to the equator the result of this
  470. *--               function will be smaller than the actual number of nautical
  471. *--               miles, but if the route passes close to the poles
  472. *--               the function result will be larger than the correct number.
  473. *-- Written for.: dBASE IV, 1.1
  474. *-- Rev. History: 03/01/1992 -- Original Release
  475. *-- Calls.......: DEG2NUM()            Function in NAVIGATE.PRG
  476. *--               HAV()                Function in TRIG.PRG
  477. *--               AHAV()               Function in TRIG.PRG
  478. *-- Called by...: Any
  479. *-- Usage.......: GCDist(<cLat1>,<cLon1>,<cLat2>,<cLon2>)
  480. *-- Example.....: ?GCDist(200,150,105,200)
  481. *-- Returns.....: Numeric (nautical miles)
  482. *-- Parameters..: cLat1 = Latitude 1
  483. *--               cLon1 = Longitude 1
  484. *--               cLat2 = Latitude 2
  485. *--               cLon2 = Longitude 2
  486. *-------------------------------------------------------------------------------
  487.  
  488.     parameters cLat1, cLon1, cLat2, cLon2
  489.     private nLa1, nLo1, nLa2, nLo2, nDla, nDlo, nTemp
  490.     nLa1 = dtor( deg2num( cLat1 ) )
  491.     nLo1 = dtor( deg2num( cLon1 ) )
  492.     nLa2 = dtor( deg2num( cLat2 ) )
  493.     nLo2 = dtor( deg2num( cLon2 ) )
  494.     nDla = abs( nLa1 - nLa2 )
  495.     nDlo = abs( nLo2 - nLo1 )
  496.     do case
  497.       case nDlo = 0 .or. nDla = pi()
  498.         RETURN 60 * rtod( nDla )
  499.       case nDlo = pi()
  500.         RETURN 60 * rtod( ( pi() - nDla ) )
  501.       case nDlo > pi()
  502.         nDlo = 2 * pi() - nDlo
  503.     endcase
  504.     nTemp = hav( nDla ) + hav( nDlo ) * cos( nLa1 ) * cos( nLa2 )
  505.  
  506. RETURN 60 * rtod( ahav( nTemp ) )
  507. *-- EoF: GcDist()
  508.  
  509. FUNCTION GcCourse
  510. *-------------------------------------------------------------------------------
  511. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  512. *-- Date........: 03/01/1992
  513. *-- Notes.......: Initial great circle course between two points given latitude
  514. *--               and longitude of each.  Returns -1 if the points are 
  515. *--               antipodes.
  516. *-- Written for.: dBASE IV, 1.1
  517. *-- Rev. History: 03/01/1992 -- Original Release
  518. *-- Calls.......: DEG2NUM()            Function in NAVIGATE.PRG
  519. *--               HAV()                Function in TRIG.PRG
  520. *--               AHAV()               Function in TRIG.PRG
  521. *--               CSCH()               Function in TRIG.PRG
  522. *-- Called by...: Any
  523. *-- Usage.......: GCCourse(<cLat1>,<cLon1>,<cLat2>,<cLon2>)
  524. *-- Example.....: ?GCCourse(200,150,105,200)
  525. *-- Returns.....: Numeric (degrees)
  526. *-- Parameters..: cLat1 = Latitude 1
  527. *--               cLon1 = Longitude 1
  528. *--               cLat2 = Latitude 2
  529. *--               cLon2 = Longitude 2
  530. *-------------------------------------------------------------------------------
  531.  
  532.     parameters nLat1, nLon1, nLat2, nLon2
  533.     private nLa1, nLo1, nLa2, nLo2, nDla, nDlo, nTemp, lRev
  534.     nLa1 = dtor( deg2num( nLat1 ) )
  535.     nLo1 = dtor( deg2num( nLon1 ) )
  536.     nLa2 = dtor( deg2num( nLat2 ) )
  537.     nLo2 = dtor( deg2num( nLon2 ) )
  538.     nDla = abs( nLa1 - nLa2 )
  539.     nDlo = abs( nLo2 - nLo1 )
  540.     lRev = .F.
  541.     do case
  542.       case nDla = pi() .or. nDlo = pi () .and. nLa1 + nLa2 = 0
  543.         RETURN -1
  544.       case nDlo = 0 .or. nDlo = pi() .or. abs( nLa1 ) = pi() .or.;
  545.              abs( nLa2 ) = pi()
  546.         RETURN iif( La1 > La2 , 180, 0 )
  547.       case nDlo > pi()
  548.         nDlo = 2 * pi() - nDlo
  549.         lRev = .T.
  550.     endcase
  551.     nTemp = hav( nDla ) + hav( nDlo ) * cos( nLa1 ) * cos( nLa2 )
  552.     nTemp = rtod( asin( sin( nDlo ) * cos( nLa2 ) * csch( ahav( nTemp ) ) ) )
  553.     nTemp = iif( nLa1 > nLa2, 180 - nTemp, nTemp )
  554.     
  555. RETURN iif( ( nLo2 > nLo1 ) = lRev, nTemp, 360 - nTemp )
  556. *-- EoF: GCCourse()
  557.  
  558. *-------------------------------------------------------------------------------
  559. *-- For convenience the following routines were brought in from other library
  560. *-- files.
  561. *-------------------------------------------------------------------------------
  562.  
  563. FUNCTION Strip2Val
  564. *-------------------------------------------------------------------------------
  565. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  566. *-- Date........: 03/01/1992
  567. *-- Notes.......: Strip characters from the left of a string until reaching
  568. *--               one that might start a number.
  569. *-- Written for.: dBASE IV
  570. *-- Rev. History: 03/01/1992  -- Original Release
  571. *-- Calls.......: None
  572. *-- Called by...: Any
  573. *-- Usage.......: Strip2Val("<cStr>")
  574. *-- Example.....: ? Strip2Val("Test345")
  575. *-- Returns.....: character string
  576. *-- Parameters..: cStr = string to search
  577. *-------------------------------------------------------------------------------
  578.  
  579.     parameters cStr
  580.    private cNew
  581.    cNew = cStr
  582.    do while "" # cNew
  583.       if left( cNew, 1 ) $ "-.0123456789"
  584.          exit
  585.        endif
  586.       cNew = substr( cNew, 2 )
  587.     enddo
  588.     
  589. RETURN cNew
  590. *-- EoF: Strip2Val()
  591.  
  592. FUNCTION StripVal
  593. *-------------------------------------------------------------------------------
  594. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  595. *-- Date........: 03/01/1992
  596. *-- Notes.......: Strip characters from the left of the string until
  597. *--               reaching one that is not part of a number.  A hyphen
  598. *--               following numerics, or a second period,
  599. *--               is treated as not part of a number.
  600. *-- Written for.: dBASE IV
  601. *-- Rev. History: 03/01/1992 -- Original Release
  602. *-- Calls.......: None
  603. *-- Called by...: Any
  604. *-- Usage.......: StripVal("<cStr>")
  605. *-- Example.....: ? StripVal("123.2Test")
  606. *-- Returns.....: Character
  607. *-- Parameters..: cStr = string to test
  608. *-------------------------------------------------------------------------------
  609.  
  610.     parameters cStr
  611.    private cNew, cChar, lGotminus, lGotdot
  612.    cNew = cStr
  613.    store .f. to lGotminus, lGotdot
  614.    do while "" # cNew
  615.       cChar = left( cNew, 1 )
  616.        do case
  617.           case .not. cChar $ "-.0123456789"
  618.             exit
  619.          case cChar = "-"
  620.              if lGotminus
  621.                exit
  622.             endif
  623.            case cChar = "."
  624.              if lGotdot
  625.                exit
  626.              else
  627.                 lGotdot = .T.
  628.              endif
  629.        endcase
  630.       cNew = substr( cNew, 2 )
  631.        lGotminus = .T.
  632.     enddo
  633.     
  634. RETURN cNew
  635. *-- EoF: StripVal()
  636.  
  637. FUNCTION StrPBrk
  638. *-------------------------------------------------------------------------------
  639. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  640. *-- Date........: 03/01/1992
  641. *-- Notes.......: Search string for first occurrence of any of the
  642. *--               characters in charset.  Returns its position as
  643. *--               with at().  Contrary to ANSI.C definition, returns
  644. *--               0 if none of characters is found.
  645. *-- Written for.: dBASE IV
  646. *-- Rev. History: 03/01/1992 -- Original Release
  647. *-- Calls.......: None
  648. *-- Called by...: Any
  649. *-- Usage.......: StrPBrk("<cCharSet>","<cBigStr>")
  650. *-- Example.....: ? StrPBrk("Tt","This is a Test string, with Test data")
  651. *-- Returns.....: Numeric value
  652. *-- Parameters..: cCharSet = characters to look for in cBigStr
  653. *--               cBigStr  = string to look in
  654. *-------------------------------------------------------------------------------
  655.  
  656.     parameters cCharset, cBigstring
  657.     private nPos, nLooklen
  658.     nPos = 0
  659.     nLooklen = len( cBigstring )
  660.     do while nPos < nLooklen
  661.       nPos = nPos + 1
  662.         if at( substr( cBigstring, nPos, 1 ), cCharset ) > 0
  663.          exit
  664.        endif
  665.     enddo
  666.     
  667. RETURN iif(nPos=nLookLen,0,nPos)
  668. *-- EoF: StrPBrk()
  669.  
  670. FUNCTION Hav
  671. *-------------------------------------------------------------------------------
  672. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  673. *-- Date........: 03/01/1992
  674. *-- Notes.......: Haversine of an angle in radians
  675. *-- Written for.: dBASE IV, 1.1
  676. *-- Rev. History: 03/01/1992 -- Original Release
  677. *-- Calls.......: None
  678. *-- Called by...: Any
  679. *-- Usage.......: Hav(<nX>)
  680. *-- Example.....: ?Hav(48)
  681. *-- Returns.....: Numeric
  682. *-- Parameters..: nX = Return Hav of X
  683. *-------------------------------------------------------------------------------
  684.  
  685.     parameters nX
  686.     
  687. RETURN ( 1 - cos( nX ) ) / 2
  688. *-- EoF: Hav()
  689.  
  690. FUNCTION AHav
  691. *-------------------------------------------------------------------------------
  692. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  693. *-- Date........: 03/01/1992
  694. *-- Notes.......: Inverse haversine - angle size in radians for given
  695. *--               haversine
  696. *-- Written for.: dBASE IV, 1.1
  697. *-- Rev. History: 03/01/1992 -- Original Release
  698. *-- Calls.......: None
  699. *-- Called by...: Any
  700. *-- Usage.......: AHav(<nX>)
  701. *-- Example.....: ?AHav(48)
  702. *-- Returns.....: Numeric
  703. *-- Parameters..: nX = Return AHav of X
  704. *-------------------------------------------------------------------------------
  705.  
  706.     parameters nX
  707.     
  708. RETURN acos( 1 - 2 * nX )
  709. *-- EoF: AHav()
  710.  
  711. FUNCTION SinH
  712. *-------------------------------------------------------------------------------
  713. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  714. *-- Date........: 03/01/1992
  715. *-- Notes.......: Hyperbolic sine of an angle X in radians
  716. *-- Written for.: dBASE IV, 1.1
  717. *-- Rev. History: 03/01/1992 -- Original Release
  718. *-- Calls.......: None
  719. *-- Called by...: Any
  720. *-- Usage.......: SinH(<nX>)
  721. *-- Example.....: ?SinH(48)
  722. *-- Returns.....: Numeric
  723. *-- Parameters..: nX = Return SinH of X
  724. *-------------------------------------------------------------------------------
  725.  
  726.     parameters nX
  727.     
  728. RETURN ( exp( nX ) - exp( -nX ) ) / 2
  729. *-- EoF: SinH()
  730.  
  731. FUNCTION CScH
  732. *-------------------------------------------------------------------------------
  733. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  734. *-- Date........: 03/01/1992
  735. *-- Notes.......: Hyperbolic cosecant of an angle X in radians
  736. *-- Written for.: dBASE IV, 1.1
  737. *-- Rev. History: 03/01/1993 -- Original Release
  738. *-- Calls.......: SINH()               Function in TRIG.PRG
  739. *-- Called by...: Any
  740. *-- Usage.......: CScH(<nX>)
  741. *-- Example.....: ?CScH(48)
  742. *-- Returns.....: Numeric
  743. *-- Parameters..: nX = Return CScH of X
  744. *-------------------------------------------------------------------------------
  745.  
  746.     parameters nX
  747.     
  748. RETURN 1 / sinh( nX )
  749. *-- EoF: CScH()
  750.  
  751. *-------------------------------------------------------------------------------
  752. *-- EoP: NAVIGATE.PRG
  753. *-------------------------------------------------------------------------------
  754.